package DBIx::EntityRecord::BaseClass;
use strict;
use Carp;
use Data::Dumper;
use Scalar::Util qw/refaddr/;
use DBIx::EntityRecord::Utils;
use UNIVERSAL;

=head1 NAME

DBIx::EntityRecord::BaseClass - base class for all entities

=head1 METHODS

=over 4

=cut

{
    my $valid_accessor_identifier_re = qr/^[A-Za-z]+[A-Za-z0-9\_]*$/;

    # PRIVATE class data
    my %classdata = ();


=item CLASS->new();

=item CLASS->new( { 'attrib1' => value, 'attrib2' => value, ... } );

returns a new instance

if given a hashref parameter, it will try to validate the attributes and 
instantiate an object with the correct attribute values. Note the ':'
is required in specifying an attribute

=cut
    sub new {
        my $class = shift;
        my $self = { };
        bless $self, $class;
        return $self if (@_ == 0);
        if (@_ == 1) {
            my $p = shift;
            (defined $p) 
                or croak "new() expects defined hashref";
            (ref($p) eq 'HASH')
                or croak "new() expects hashref";
            # expects attributes 
            my %attribs = map { $_ => 1 } $class->_attributes_list();
            while (my ($key, $value) = each %$p) {
                #print STDERR Dumper( { "DEBUG" => [ \%attribs, $p, $key, $enckey ] } );
                (defined $key and exists $attribs{$key})
                    or croak "new(): invalid attribute";
                my $method = $key;
                $self->$method( $value );
            }
            
        }
        return $self;
    }


=item CLASS->_attribute( $attribname )

=item CLASS->_attribute( $attribname, \%options )

creates the necessary accessors for attributes

croaks if the accessor or method already exists

=cut
# TODO: document \%options
    sub _attribute {
        my $class = shift;
        (not ref($class))
            or croak "_attribute() is a class method";
        my ( $method, $options ) = @_;
        (defined $method and ($method =~ $valid_accessor_identifier_re))
            or croak "(\$attributename) expected to be defined and valid";
        if (defined $options) {
            (ref($options) eq 'HASH')
                or croak "(\$attributename,\\\%options) expected defined";
        }
        my $fullmethod = join "::", $class, $method;
        {
            no strict 'refs';        
            not defined(&{$fullmethod}) 
                or croak "method $fullmethod is being redefined";
            my %a = ();
            # create inside out accessor
            *{$fullmethod} = sub {
                return $a{refaddr($_[0])} if @_ == 1;
                return $a{refaddr($_[0])}=$_[1] if @_ == 2;
                return $a{refaddr(shift @_)}=\@_;
            };
            if (not defined $classdata{$class}{attributes}) {
                $classdata{$class}{attributes} = {};
            }
            $classdata{$class}{attributes}{$method} = 1;
        }
    }


=item CLASS->_attributes_list()

getter method, returns a list of attributes for the given CLASS

=cut
    sub _attributes_list {
        my $class = shift;
        return keys %{$classdata{$class}{attributes}};
    }



=item CLASS->_oid_key()

=item CLASS->_oid_key( $oid_attrib_string )

defines the oid key based on existing attribute definitions

=cut
    sub _oid_key {
        return $classdata{$_[0]}{oid} if (@_ == 1);
        if (@_ == 2) {
            my $class = $_[0];
            my $attrib = $_[1];
            (defined $classdata{$class}{attributes}{$attrib})
                or croak "cannot use invalid attribute as oid";
            return $classdata{$class}{oid} = $attrib;
        }
        # TODO: future work to support composite keys ...
        croak "_oid_key() does not support composite keys yet";
    }


=item CLASS->_belongs_to( $accessormethod, $related_class )

defines a many-to-one relationship between CLASS and $related 
class through the accessor $accessormethod

requires CLASS and $related class to have a proper oid.

requires $accessormethod to be a unique method not
previously defined

=cut
    sub _belongs_to {
        my $class = shift;
        my $method = shift;
        my $relative_class = shift;
        (defined $method and ($method =~ $valid_accessor_identifier_re))
            or croak "invalid accessor identifier";
        ((defined $class->_oid_key) and (exists $classdata{$class}))
            or croak "class requires valid oid set";
        (not exists $classdata{$class}{attributes}{$method})
            or croak "accessor '$method' already used as an attribute";
        ((defined $relative_class->_oid_key) and (exists $classdata{$relative_class}))
            or croak "related_class requires valid oid set";
        # define the accessor
        my $fullmethod = join "::", $class, $method;
        {
            no strict 'refs';        
            not defined(&{$fullmethod}) 
                or croak "method $fullmethod is being redefined";
            my %a = ();
            # create inside out accessor
            *{$fullmethod} = sub {
                return $a{refaddr($_[0])} if @_ == 1;
                if (@_ == 2) {
                    ((defined $_[1]) and (UNIVERSAL::isa($_[1], $relative_class)))
                        or croak "$fullmethod($relative_class) expected";
                    return $a{refaddr($_[0])}=$_[1];
                }
                croak "$fullmethod($relative_class) expected";
            };
            if (not defined $classdata{$class}{belongs_to}) {
                $classdata{$class}{belongs_to} = {};
            }
            $classdata{$class}{belongs_to}{$method} = $relative_class;
        }
        
        
    }




}


1;
__END__

=back

=head1 AUTHOR

Dexter Tad-y <dexterbt1 AT yahoo.com>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 by Dexter Tad-y

Permission is hereby granted, free of charge, to any person obtaining a copy 
of this software and associated documentation files (the "Software"), to deal 
in the Software without restriction, including without limitation the rights 
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 
copies of the Software, and to permit persons to whom the Software is 
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in 
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 
THE SOFTWARE.

